home *** CD-ROM | disk | FTP | other *** search
- /*
- * Mac hack of
- * exec.c - grasp language execution routines.
- *
- * Copyright (c) 1991 by Patrick J. Naughton
- */
-
- #pragma segment Exec
-
- #include <math.h>
- #include "glassert.h"
- #include "grasp.h"
- #include "fades.h"
- #include "procImage.h"
- #define __INSTANTIATE__
- #include "exec.h"
-
-
- extern void error (...);
-
- void printexec (ExecStruct *ex, int nargs);
-
-
- #define EXEC_ERROR() \
- { \
- extern Bool aboutdone; \
- \
- \
- printexec (ex, nargs); \
- aboutdone = True; \
- error ("%s: argcount mismatch\n"); \
- }
-
-
- #define UNIMPLEMENTED 1
-
- #define ESCAPE -3
- #define DONE -2
- #define CONT -1
-
- #define intarg(ex,index) (ex)->Code[(index)].val.i
- #define strarg(ex,index) (ex)->Code[(index)].val.s
- #define imgarg(ex,index) (ex)->Code[(index)].val.image
- #define fntarg(ex,index) (ex)->Code[(index)].val.font
- #define excarg(ex,index) (ex)->Code[(index)].val.exec
-
- Colormap EGAcmap = (Colormap) 0;
-
- XRectangle window = { 0, 0, 0, 0 };
-
- typedef struct {
- int count;
- int ipaddr;
- } stackent;
- #define STACKSIZE 16
-
- stackent loopstack[STACKSIZE];
- int loopstackptr = 0;
-
- int ipstack[STACKSIZE];
- int ipstackptr = 0;
-
- ImageStruct *clipreg[128];
- FontStruct *fontreg[16];
- FontStruct *currentfont = 0;
- int fstyle = 0;
- int chargap = 1;
- int spacegap = -1;
- int currentcolor = 1;
- int currentbgcolor = 0;
- Colormap installedcmap = (Colormap) NULL;
- u_short palettenum = 0;
- int tranval = -1;
- int keypressed = -1;
- int videomode;
-
- static short xOffset = 0;
- static short yOffset = 0;
-
- static u_short lastRegnum = -1; /* index of last PLOADed image */
-
-
- void
- InitExec (void)
-
- {
- u_short i;
-
-
- for (i = 0; i < PICREGSIZE; i++)
- picreg[i] = (ImageStruct *) NULL;
-
- for (i = 0; i < 128; i++)
- clipreg[i] = (ImageStruct *) NULL;
-
- for (i = 0; i < 16; i++)
- fontreg[i] = (FontStruct *) NULL;
- }
-
- void
- exitcheck()
- {
- SystemTask ();
-
- if (FrontWindow () != (WindowPtr) dsp)
- SelectWindow ((WindowPtr) dsp);
-
- if (StopKey()) XExit(0);
- }
-
- /*
- * delay sleeps for 'd'/100'ths of a second
- * usleep() will have to be provided on non-sun platforms.
- */
- void
- delay(d)
- int d;
- {
- long endtime = hundredthsofseconds() + d;
- int i,hos;
-
- while (1) {
- exitcheck();
- usleep(10000); //<< BAD /* sleep for 1/100th of a second */
- if (hundredthsofseconds() > endtime)
- return;
- }
- }
-
-
- /*
- * if ip is pointing at a wildcard '*' then resolvewild returns a pointer
- * to the object which is referenced by the current data pointer.
- * otherwise it checks the type of the ip to make sure it matches what
- * the caller expected, plus a little hack for zero's mistyped as oh's.
- */
- void *
- resolvewild(ex, ip, type)
- ExecStruct *ex;
- int ip;
- int type;
- {
- int i;
-
- if (ex->Code[ip].token == WILDTYPE) {
- if (ex->currentdataptr == -1)
- error("%s: resolvewild no data\n");
- i = ex->currentdataptr++;
- } else {
- i = ip;
- if (ex->Code[i].token != type) {
- /* hack for mistyped zero's as Oh's */
- if (ex->Code[i].token == STRING && ex->Code[i].val.s[0] == 'o') {
- ex->Code[i].token = INTEGER;
- ex->Code[i].val.i = 0;
- } else
- error("%s: resolvewild type mismatch.\n");
- }
- }
-
- switch (type) {
- case STRING:
- return (void *) ex->Code[i].val.s;
- break;
- case INTEGER:
- return (void *) ex->Code[i].val.i;
- break;
- case IMAGE:
- if (ex->Code[i].token == STRING)
- stringtoimage(i, EXT_CLP);
- return (void *) ex->Code[i].val.image;
- break;
- case FONTTYPE:
- if (ex->Code[i].token == STRING)
- stringtofont(i);
- return (void *) ex->Code[i].val.font;
- break;
- default:
- error("%s: resolvewild type failure\n");
- }
- }
-
- /*
- * installs the colormap associated with the image argument.
- */
- void
- installcmap(i)
- {
- ImageStruct *im;
-
- palettenum = i;
-
- assert (palettenum < PICREGSIZE);
-
- im = picreg[i];
- if (im) {
- if ((installedcmap = im->cmap) /* != (Colormap) NULL */)
- XSetWindowColormap(dsp, win, im->cmap);
- else
- fprintf (stderr, "installcmap (): no colormap for image at %d\n", i);
- } else {
- fprintf(stderr,"installcmap (): no image at %d\n", i);
- installedcmap = (Colormap) 0;
- }
- }
-
- void
- setvideomode (int c) /* from "(char c)" declaration. THINK C 5.0.4 bug when */
- /* externally declared and used: char not promoted to int. :( */
-
- {
- int w = 0;
- int h = 0;
-
-
- if (c >= 'A' && c <= 'Z')
- c += 'a' - 'A';
-
- if (EGAcmap == (Colormap) 0)
- EGAcmap = CreateEGAcmap();
-
- videomode = c;
- switch (c)
- {
- case '1': /* 80x25 text 16 color */
- w = 80 * 8;
- h = 25 * 13 + 4;
- installedcmap = (Colormap) 0;
- palettenum = 0;
- XSetWindowColormap(dsp, win, EGAcmap);
- break;
- case 'a': /* 320x200 4 color */
- w = 320;
- h = 200;
- break;
- case 'c': /* 640x200 2 color */
- w = 640;
- h = 400;
- break;
- case 'e': /* 640x350 2 color */
- w = 640;
- h = 350;
- break;
- case 'g': /* 640x350 16 colors */
- w = 640;
- h = 350;
- break;
- case 'h': /* 720x384 2 colors */
- w = 720;
- h = 384;
- break;
- case 'i': /* 640x350 16 colors */
- w = 640;
- h = 350;
- break;
- case 'j': /* 640x480 16 colors */
- w = 640;
- h = 480;
- break;
- case 'k': /* 640x350 16 colors */
- w = 640;
- h = 350;
- break;
- default:
- fprintf (stderr, "Unrecognized video mode '%c'; using default.\n", c);
- case 'l': /* 320x200 256 color */
- w = 320;
- h = 200;
- break;
- case 'm': /* 640x480 256 color */
- w = 640;
- h = 480;
- break;
- case 'n': /* 720x348 16 color */
- w = 720;
- h = 348;
- break;
- case 'o': /* 640x480 2 color */
- w = 640;
- h = 480;
- break;
- case 'p': /* 800x600 2 color */
- w = 800;
- h = 600;
- break;
- case 'q': /* 800x600 16 color */
- w = 800;
- h = 600;
- break;
- case 'r': /* 800x600 256 color */
- w = 640;
- h = 350;
- break;
- case 's': /* 800x600 256 color */
- w = 640;
- h = 480;
- break;
- case 't': /* 800x600 256 color */
- w = 800;
- h = 600;
- break;
- case 'w': /* 360x480 256 color */
- w = 360;
- h = 480;
- break;
-
- case '?': /* maximum dimensions of all loaded images */
- {
- u_short i;
-
-
- w = 0;
- h = 0;
-
- for (i = 0; i < PICREGSIZE; i++)
- {
- ImageStruct *pIm = picreg[i];
-
-
- if (pIm /* != (ImageStruct *) NULL */)
- {
- if (pIm->w > w)
- w = pIm->w;
- if (pIm->h > h)
- h = pIm->h;
- }
- }
-
- if (verbose)
- {
- fprintf (stderr, "Max window size: %dx%d (0x%lx)\n", w, h, picreg[0]);
- fflush (stderr);
- }
-
- if (w == 0 || h == 0)
- return;
-
- break;
- }
- }
-
- AdjustBackgroundPic (w, h);
- }
-
-
- void
- AdjustBackgroundPic (int w, int h)
-
- {
- if (picreg[0] == (ImageStruct *) NULL ||
- picreg[0]->w != w || picreg[0]->h != h)
- {
- if (picreg[0] /* != (ImageStruct *) NULL */)
- {
- XFreePixmap(dsp, picreg[0]->pix);
- if (picreg[0]->cmap)
- XFreeColormap(dsp, picreg[0]->cmap);
- free(picreg[0]);
- }
-
- picreg[0] = (ImageStruct *) malloc((size_t) sizeof(ImageStruct));
- assert (picreg[0]);
- picreg[0]->name = "background";
- picreg[0]->type = EXT_PIC;
- picreg[0]->w = w;
- picreg[0]->h = h;
- picreg[0]->d = 8;
- picreg[0]->xoff = 0;
- picreg[0]->yoff = 0;
- picreg[0]->pix = XCreatePixmap(dsp, win, w, h, 8);
- XSetForeground(dsp, gc, 0);
- XFillRectangle(dsp, picreg[0]->pix, gc, 0, 0, w, h);
- picreg[0]->cmap = (Colormap) 0;
- picreg[0]->cmaplen = 0;
-
- XResizeWindow (dsp, win, w, h);
- }
-
- window.x = window.y = 0;
- window.width = w;
- window.height = h;
-
- {
- Rect aRect;
- GrafPtr oldPort;
-
-
- GetPort (&oldPort);
- SetPort ((WindowPtr) dsp);
- SetRect (&aRect, 0, 0, w, h);
- FillRect (&aRect, white);
- SetPort (oldPort);
- }
-
- XSync (dsp, False);
- }
-
-
- int
- unimplemented(ex, ip)
- ExecStruct *ex;
- int ip;
- {
- fprintf(stderr,"%s: ", tokens[ex->Code[ip - 1].token]);
- fprintf(stderr,"unimplemented operator.\n");
- return CONT;
- }
-
- #define defrect(r, X, Y, W, H) \
- (r).x = X, (r).y = Y, (r).width = W, (r).height = H
-
- void
- drawWideRect(dpy, win, gc, x, y, w, h, thick)
- Display *dpy;
- Window win;
- GC gc;
- int x, y, w, h;
- int thick;
- {
- XRectangle rects[4];
- int nrects, doublethick;
-
- if (w == 0 && h == 0)
- return;
-
- doublethick = 2 * thick;
-
- // if too small for box just draw one solid rect
-
- if (w <= doublethick || h <= doublethick) {
- defrect(rects[0], x, y, w, h);
- nrects = 1;
- // else draw all 4 rects for the box
- } else {
- defrect(rects[0], x, y, w, thick);
- defrect(rects[1], x, y + h - thick, w, thick);
- defrect(rects[2], x, y + thick, thick, h - doublethick);
- defrect(rects[3], x + w - thick, y + thick, thick, h - doublethick);
- nrects = 4;
- }
- XFillRectangles(dpy, win, gc, rects, nrects);
- }
-
-
- /*-
- * BOX x1 y1 x2 y2 [thickness]
- * draws a hollow rectangle in the current color as thick as specified.
- */
-
- int
- f_box(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int x1;
- int y1;
- int x2;
- int y2;
- int th;
-
- switch (nargs) {
- default:
- case 5:
- th = intarg(ex, ip + 4);
- break;
- case 4:
- th = 1;
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- x1 = intarg(ex, ip);
- y1 = intarg(ex, ip + 1);
- x2 = intarg(ex, ip + 2);
- y2 = intarg(ex, ip + 3);
-
- XSetForeground(dsp, gc, currentcolor);
- drawWideRect(dsp, win, gc, x1, YFLIP(y2), x2 - x1, y2 - y1, th);
-
- return CONT;
- }
-
- /*-
- * BREAK label
- * break out of a loop.
- */
- int
- f_break(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
-
- /*-
- * CALL file [label]
- */
- int
- f_call(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- void execfile();
- int label;
-
- switch (nargs) {
- default:
- case 2:
- label = intarg(ex, ip + 1);
- break;
- case 1:
- label = 0;
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- execfile(excarg(ex, ip), label);
-
- return CONT;
- }
-
- /*-
- * CFADE fadenumber x y [buffernumber] [speed] [delay]
- * fade the given buffer using the given fade number at x,y.
- */
- int
- f_cfade(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int fadestyle;
- int x;
- int y;
- u_short buf = 1;
- int speed = 0;
- int d = 10;
- ImageStruct *im;
-
-
- switch (nargs) {
- default:
- case 6:
- d = intarg(ex, ip + 5);
- case 5:
- speed = intarg(ex, ip + 4);
- case 4:
- buf = intarg(ex, ip + 3);
- case 3:
- y = intarg(ex, ip + 2);
- x = intarg(ex, ip + 1);
- fadestyle = intarg(ex, ip);
- break;
- case 0:
- case 1:
- case 2:
- EXEC_ERROR ();
- break;
- }
-
- assert (buf < 128);
-
- assert (im = clipreg[buf] /* != (ImageStruct *) NULL */);
-
- imagefade(fadestyle, im,
- x + im->xoff, YFLIPIM(y, im) + im->yoff, speed, 0);
-
- delay(d);
-
- return CONT;
- }
-
- /*-
- * CFREE buffer [buffer] ...
- * unload a clipping
- */
- int
- f_cfree(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 0:
- EXEC_ERROR ();
- break;
- default:
- break;
- }
- #endif
-
- /* NOP */
- return CONT;
- }
-
- /*-
- * CGETBUF n [x1 y1 x2 y2] [noshift] [tran]
- * copy an area of the screen into a clip buffer
- */
- int
- f_cgetbuf(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- u_short clip;
- int x1;
- int y1;
- int x2;
- int y2;
- ImageStruct *im;
- XImage *xim;
-
- switch (nargs){
- default:
- case 7:
- case 6:
- case 5:
- y2 = intarg(ex, ip + 4);
- x2 = intarg(ex, ip + 3);
- y1 = intarg(ex, ip + 2);
- x1 = intarg(ex, ip + 1);
- case 1:
- clip = intarg(ex, ip);
- break;
- case 0:
- case 2:
- case 3:
- case 4:
- EXEC_ERROR ();
- break;
- }
-
- im = (ImageStruct *) malloc((size_t) sizeof(ImageStruct));
- assert (im);
- im->name = "getbuf";
- im->w = x2 - x1;
- im->h = y2 - y1;
- im->d = 8;
- im->cmap = (Colormap) 0;
- im->cmaplen = 0;
- im->pix = XCreatePixmap(dsp, win, im->w, im->h, 8);
-
- assert (clip < 128);
- clipreg[clip] = im;
-
- // xim = XGetImage(dsp, win, x1, y1, im->w, im->h, 0xff, ZPixmap);
- // XPutImage(dsp, im->pix, gc, xim, 0, 0, 0, 0, im->w, im->h);
- // free(xim->data);
- // free(xim);
-
- return CONT;
- }
-
- /*-
- * CHGCOLOR slot val [slot val] ...
- * change palette colors in EGA mode.
- */
- int
- f_chgcolor(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int i;
- u_long pmasks;
- u_long pixels[16];
- ImageStruct *im = picreg[0];
-
-
- assert (im);
-
- switch (nargs) {
- case 0:
- EXEC_ERROR ();
- break;
- default:
- switch (nargs % 2) {
- case 1:
- EXEC_ERROR ();
- break;
- default:
- break;
- }
- break;
- }
-
- im->cmaplen = 16; /* EGA hard-coded value */
- if (!im->cmap) {
- im->cmap = XCreateColormap(dsp, win, vis, AllocNone);
- XAllocColorCells(dsp, im->cmap, True, (unsigned long *) &pmasks,
- 0, (unsigned long *) pixels, im->cmaplen);
- }
-
- for (i = 0; i < nargs; i += 2) {
- int slot = intarg(ex, ip + i);
- int pal = intarg(ex, ip + i + 1);
-
- im->colors[slot].pixel = slot;
- im->colors[slot].red = decodepal(pal, 0x20, 0x04) << 8;
- im->colors[slot].green = decodepal(pal, 0x10, 0x02) << 8;
- im->colors[slot].blue = decodepal(pal, 0x08, 0x01) << 8;
- im->colors[slot].flags = DoRed | DoGreen | DoBlue;
-
- // XStoreColor(dsp, im->cmap, &(im->colors[slot]));
- }
-
- installcmap(0);
-
- return CONT;
- }
-
- /*-
- * CIRCLE x y xr [yr] [iris]
- * draw an ellipse
- */
- int
- f_circle(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 5:
- case 4:
- case 3:
- break;
- case 0:
- case 1:
- case 2:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * CLEARSCR
- * paint entire screen
- */
- int
- f_clearscr(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #if 0
- switch (nargs) {
- case 0:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- if (picreg[0] == 0)
- setvideomode('l');
- XSetForeground(dsp, gc, currentcolor);
- if (picreg[0] /* != (ImageStruct *) NULL */)
- {
- XFillRectangle(dsp, picreg[0]->pix, gc,
- 0, 0, picreg[0]->w, picreg[0]->h);
-
- // XCopyArea(dsp, picreg[0]->pix, win, gc,
- // 0, 0, picreg[0]->w, picreg[0]->h, 0, 0);
- }
-
- return CONT;
- }
-
- /*-
- * CLOAD name [buffer] [noshift] [tran]
- * load a clipping
- */
- int
- f_cload(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- u_short clip;
-
- switch (nargs) {
- default:
- case 4:
- case 3:
- case 2:
- clip = (u_short) resolvewild(ex, ip + 1, INTEGER);
- break;
- case 1:
- clip = 0;
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- assert (clip < 128);
- clipreg[clip] = (ImageStruct *) resolvewild(ex, ip, IMAGE);
-
- return CONT;
- }
-
- /*-
- * CLOSEGL
- * close a library file
- */
- int
- f_closegl(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 0:
- break;
- #if 0
- default:
- EXEC_ERROR ();
- break;
- #endif
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * COLOR color1 [R] [color2]
- * set the drawing color, (not sure what the R is...)
- */
- int
- f_color(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
-
- switch (nargs) {
- default:
- case 2:
- currentbgcolor = intarg(ex, ip + 1);
- case 1:
- currentcolor = intarg(ex, ip);
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- return CONT;
- }
-
- /*-
- * CYCLE cycles start number [time]
- * rotate palette colors.
- */
- int
- f_cycle(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int cycles;
- int start;
- int number;
- int d = 0;
- int i;
- int j;
- int end;
- ImageStruct *pIm = picreg[palettenum];
- XColor *c;
- unsigned long buffer;
-
-
- assert (pIm);
- assert (c = pIm->colors);
-
- switch (nargs) {
- default:
- case 4:
- d = intarg(ex, ip + 3);
- case 3:
- number = intarg(ex, ip + 2);
- start = intarg(ex, ip + 1);
- cycles = intarg(ex, ip);
- break;
- case 0:
- case 1:
- case 2:
- EXEC_ERROR ();
- break;
- }
-
- end = start + number - 1;
-
- for (i = 0; i < cycles; i++) {
- buffer = c[start].pixel;
- for (j = start; j < end; j++)
- c[j].pixel = c[j + 1].pixel;
- c[end].pixel = buffer;
- XStoreColors(dsp, installedcmap, &c[start], number);
- XSync(dsp, False);
- if (d)
- delay(d);
- }
- return CONT;
- }
-
- /*-
- * DATA item [item] ...
- * define data elements
- */
- int
- f_data(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- case 0:
- EXEC_ERROR ();
- break;
- default:
- break;
- }
-
- ex->currentdataptr = ip;
- return CONT;
- }
-
- /*-
- * DATABEGIN
- * define data elements (multiple lines)
- */
- int
- f_databegin(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- case 1:
- ex->currentdataptr = intarg(ex, ip);
- break;
- default:
- ex->currentdataptr = ip;
- break;
- }
-
- return CONT;
- }
-
- /*-
- * DATAEND
- * mark the end of a data block
- */
- int
- f_dataend(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- case 0:
- break;
- #if 0
- default:
- EXEC_ERROR ();
- break;
- #endif
- }
-
- ex->currentdataend = ip - 2;
- return CONT;
- }
-
- /*-
- * DATASKIP n
- * skip n data elements in a block.
- */
- f_dataskip(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- default:
- case 1:
- ex->currentdataptr += intarg(ex, ip);
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * DFREE buffer [buffer] ...
- *
- */
- int
- f_dfree(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 0:
- EXEC_ERROR ();
- break;
- default:
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * DLOAD name [buffer] [disk]
- * load a differential animation file.
- */
- int
- f_dload(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 3:
- case 2:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * EDGE setting [color]
- * turn leading edge for fades on or off.
- */
- int
- f_edge(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 2:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * ELSE
- * target for IF condition not met.
- */
- int
- f_else(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 0:
- EXEC_ERROR ();
- break;
- default:
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * ENDLFLOAT
- * clear the float background buffer.
- */
- int
- f_endlfloat(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 0:
- EXEC_ERROR ();
- break;
- default:
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * ENDIF
- * mark the end of an if-else block
- */
- int
- f_endif(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 0:
- EXEC_ERROR ();
- break;
- default:
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * EXEC name [options]
- * run a non-grasp program.
- */
- int
- f_exec(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 2:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * EXIT [value]
- * exit grasp or subprogram.
- */
- int
- f_exit(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- case 1:
- case 0:
- break;
- #if 0
- default:
- EXEC_ERROR ();
- break;
- #endif
- }
-
- delay(100);
- return DONE;
- }
-
- /*-
- * FFREE [buffer] ...
- * unload a font
- */
- int
- f_ffree(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- break;
- }
- #endif
-
- /* NOP */
- return CONT;
- }
-
- /*-
- * FGAPS char [space]
- * set letter and word spacing
- */
- int
- f_fgaps(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- default:
- case 2:
- spacegap = intarg(ex, ip + 1);
- case 1:
- chargap = intarg(ex, ip);
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- return CONT;
- }
-
- /*-
- * FLOAD name [buffer]
- * load a font
- */
- int
- f_fload(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- FontStruct *f;
- u_short reg = 1;
-
- switch (nargs) {
- default:
- case 2:
- reg = intarg(ex, ip + 1);
- case 1:
- f = fntarg(ex, ip);
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- assert (reg < 16);
- fontreg[reg] = f;
- currentfont = f;
-
- chargap = 1;
- spacegap = f->glyphs[' '].width;
-
- return CONT;
- }
-
- /*-
- * FLOAT x1 y1 x2 y2 step delay buf [buf] ...
- * animate a clipping and preserve the background.
- */
- int
- f_float(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- u_short ithImage;
- int x1;
- int y1;
- int x2;
- int y2;
- int step;
- int d;
- int i;
- int image;
- int count;
- float x;
- float y;
- float dx;
- float dy;
- Window floatwin;
- ImageStruct *im;
- XSetWindowAttributes xswa;
-
- switch (nargs) {
- case 6:
- case 5:
- case 4:
- case 3:
- case 2:
- case 1:
- case 0:
- EXEC_ERROR ();
- break;
- default:
- ithImage = intarg(ex, ip + 6);
- assert (ithImage < 128);
- im = clipreg[ithImage];
- assert (im);
- d = intarg(ex, ip + 5);
- step = intarg(ex, ip + 4);
- y2 = intarg(ex, ip + 3);
- x2 = intarg(ex, ip + 2);
- y1 = intarg(ex, ip + 1);
- x1 = intarg(ex, ip);
- break;
- }
-
- // xswa.backing_store = Always;
- floatwin = XCreateWindow(dsp, win, x1, YFLIPIM(y1, im), im->w, im->h, 0, 8,
- InputOutput, vis, CWBackingStore, &xswa);
- XCopyArea(dsp, im->pix, floatwin, gc, 0, 0, im->w, im->h, 0, 0);
- XMapWindow(dsp, floatwin);
-
- if (x1 == x2 && y1 == y2 ) {
- for (image = 7; image < nargs; image++) {
- u_short ithImage = intarg(ex, ip + image);
-
-
- assert (ithImage < 128);
- im = clipreg[ithImage];
- assert (im);
- XMoveResizeWindow(dsp, floatwin, x1, YFLIPIM(y1, im), im->w, im->h);
- XCopyArea(dsp, im->pix, floatwin, gc, 0, 0, im->w, im->h, 0, 0);
- XSync(dsp, False);
- delay(d);
- }
- } else {
- x = x1;
- y = y1;
- dx = (x2 - x1);
- dy = (y2 - y1);
- count = sqrt(dx * dx + dy * dy) / step;
- dx /= count;
- dy /= count;
- image = 7;
-
- for (i = 0; i <= count; i++) {
- if (nargs > 7) {
- u_short ithImage = intarg(ex, ip + image);
-
-
- assert (ithImage < 128);
- im = clipreg[ithImage];
- assert (im);
- if (++image == nargs)
- image = 6;
- }
- XMoveResizeWindow(dsp, floatwin, (int) x, YFLIPIM((int) y, im),
- im->w, im->h);
- XCopyArea(dsp, im->pix, floatwin, gc, 0, 0, im->w, im->h, 0, 0);
- XSync(dsp, False);
- x += dx;
- y += dy;
- delay(d);
- }
- }
-
- XUnmapWindow(dsp, floatwin);
- XDestroyWindow(dsp, floatwin);
- return CONT;
- }
-
- /*-
- * FLY x1 y1 x2 y2 step delay buf [buf] ...
- * animate a clipping
- */
- int
- f_fly(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- u_short ithImage;
- int x1;
- int y1;
- int x2;
- int y2;
- int step;
- int d;
- int i;
- int image;
- u_short count;
- float x;
- float y;
- float dx;
- float dy;
- ImageStruct *im;
-
- switch (nargs) {
- case 6:
- case 5:
- case 4:
- case 3:
- case 2:
- case 1:
- case 0:
- EXEC_ERROR ();
- break;
- default:
- ithImage = intarg(ex, ip + 6);
- assert (ithImage < 128);
- im = clipreg[ithImage];
- assert (im);
- d = intarg(ex, ip + 5);
- step = intarg(ex, ip + 4);
- y2 = intarg(ex, ip + 3);
- x2 = intarg(ex, ip + 2);
- y1 = intarg(ex, ip + 1);
- x1 = intarg(ex, ip);
- break;
- }
-
- XCopyArea(dsp, im->pix, win, gc, 0, 0, im->w, im->h, x1, YFLIPIM(y1, im));
-
- if (x1 == x2 && y1 == y2 ) {
- for (image = 7; image < nargs; image++) {
- u_short ithImage = intarg(ex, ip + image);
-
-
- assert (ithImage < 128);
- im = clipreg[ithImage];
- assert (im);
- XCopyArea(dsp, im->pix, win, gc, 0, 0, im->w, im->h,
- x1, YFLIPIM(y1, im));
- XSync(dsp, False);
- delay(d);
- }
- } else {
- x = x1;
- y = y1;
- dx = (x2 - x1);
- dy = (y2 - y1);
- count = sqrt(dx * dx + dy * dy) / step;
- dx /= count;
- dy /= count;
- image = 7;
-
- for (i = 0; i <= count; i++) {
- if (nargs > 7) {
- u_short ithImage = intarg(ex, ip + image);
-
-
- assert (ithImage < 128);
- im = clipreg[ithImage];
- assert (im);
- if (++image == nargs)
- image = 6;
- }
- XCopyArea(dsp, im->pix, win, gc, 0, 0, im->w, im->h,
- (int) x, YFLIPIM((int) y, im));
- XSync(dsp, False);
- x += dx;
- y += dy;
- delay(d);
- }
- }
-
- return CONT;
- }
-
- /*-
- * FONT [buffer]
- * select a font
- */
- int
- f_font(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- default:
- case 1:
- {
- u_short reg = intarg(ex, ip);
-
-
- assert (reg < 16);
- currentfont = fontreg[reg];
- break;
- }
- case 0:
- currentfont = fontreg[0];
- break;
- #if 0
- default:
- EXEC_ERROR ();
- break;
- #endif
- }
-
- return CONT;
- }
-
- /*-
- * FSTYLE dir off1 [off2]
- * set character shading... (I think this changed between 1.1 and 3.0)
- */
- int
- f_fstyle(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- default:
- case 1:
- case 2:
- case 3:
- fstyle = intarg(ex, ip);
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- return CONT;
- }
-
- /*-
- * GETCOLOR x y
- * set the drawing color equal to the screen pixel.
- */
- int
- f_getcolor(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int x = intarg(ex, ip);
- int y = intarg(ex, ip + 1);
- XImage *xim;
-
- switch (nargs) {
- default:
- case 2:
- y = YFLIP(intarg(ex, ip + 1));
- x = intarg(ex, ip);
- break;
- case 0:
- case 1:
- EXEC_ERROR ();
- break;
- }
-
- // xim = XGetImage(dsp, win, x, YFLIP(y), 1, 1, 0xff, ZPixmap);
- // currentcolor = XGetPixel(xim, 0, 0);
- fprintf(stderr,"getcolor %d,%d = %d\n", x, y, currentcolor);
- // XDestroyImage(xim);
-
- return CONT;
- }
-
- /*-
- * GETKEY name
- * set a variable equal to a keystroke
- */
- int
- f_getkey(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * GOSUB label [val] ...
- * execute a subroutine
- */
- int
- f_gosub(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- default:
- case 2:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- ipstack[ipstackptr] = ip + 1;
- if (++ipstackptr >= STACKSIZE)
- error("%s: ipstack overflow\n");
-
- return intarg(ex, ip);
- }
-
- /*-
- * GOTO label
- * jump to a label
- */
- int
- f_goto(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- default:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- return intarg(ex, ip);
- }
-
- /*-
- * IF exp [label]
- * jump if condition is met, or start if-else block if no label.
- */
- int
- f_if(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- default:
- case 2:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * IFKEY key [label [key label] ... ]
- * check for specific keypress
- */
- int
- f_ifkey(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int i;
-
- switch (nargs) {
- case 0:
- EXEC_ERROR ();
- break;
- default:
- break;
- }
-
- for (i = 0; i < nargs; i += 2) {
- char *key = strarg(ex, ip + i);
- if (*key == keypressed)
- return intarg(ex, ip + i + 1);
- }
-
- return CONT;
- }
-
- /*-
- * IFMEM mem [label]
- * check available memory.
- */
- int
- f_ifmem(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- /* ignore the memory value */
-
- int label;
-
- switch (nargs) {
- default:
- case 2:
- label = intarg(ex, ip + 1);
- break;
- case 1:
- label = CONT;
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- return label;
- }
-
- /*-
- * IFMOUSE button [label1] [x y x1 y1] [color] [wait] [label2]
- * check for a mouse click (no idea how this one is supposed to work).
- */
- int
- f_ifmouse(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 9:
- case 8:
- case 7:
- case 6:
- case 2:
- case 1:
- break;
- case 0:
- case 3:
- case 4:
- case 5:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * IFVIDEO mode [label]
- * check whether video mode is available
- */
- int
- f_ifvideo(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int label;
-
- switch (nargs) {
- default:
- case 2:
- label = intarg(ex, ip + 1);
- break;
- case 1:
- label = CONT;
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- return label;
- }
-
- /*-
- * INT num [ax] [bx] [cx] [dx] [si] [di] [ds] [es]
- * call an MSDOS interrupt... (yeah, right!)
- */
- int
- f_int(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 9:
- case 8:
- case 7:
- case 6:
- case 5:
- case 4:
- case 3:
- case 2:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- static int linex1 = 0;
- static int liney1 = 0;
- static int linex2 = 0;
- static int liney2 = 0;
-
- /*-
- * LINE x1 y1 x2 y2 [R]
- * draw a line, (possibly relative to the current point).
- */
- int
- f_line(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- default:
- case 5:
- linex1 += intarg(ex, ip);
- liney1 += intarg(ex, ip + 1);
- linex2 += intarg(ex, ip + 2);
- liney2 += intarg(ex, ip + 3);
- break;
- case 4:
- linex1 = intarg(ex, ip);
- liney1 = intarg(ex, ip + 1);
- linex2 = intarg(ex, ip + 2);
- liney2 = intarg(ex, ip + 3);
- break;
- case 0:
- case 1:
- case 2:
- case 3:
- EXEC_ERROR ();
- break;
- }
-
- XSetForeground(dsp, gc, currentcolor);
- XDrawLine (dsp, win, gc,
- linex1 + xOffset, YFLIP(liney1 + yOffset),
- linex2 + xOffset, YFLIP(liney2 + yOffset));
- XSync(dsp, False);
-
- return CONT;
- }
-
- /*-
- * LINK name [label]
- * jump to another program
- */
- int
- f_link(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int label;
-
- switch (nargs) {
- default:
- case 2:
- label = intarg(ex, ip + 1);
- break;
- case 1:
- label = 0;
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- execfile(excarg(ex, ip), label);
-
- return DONE;
- }
-
- /*-
- * LOCAL var value
- * define a local variable
- */
- int
- f_local(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 2:
- break;
- case 0:
- case 1:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * LOOP
- * define the end of a MARK'ed loop.
- */
- int
- f_loop(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- case 0:
- break;
- #if 0
- default:
- EXEC_ERROR ();
- break;
- #endif
- }
-
- if (--loopstack[loopstackptr - 1].count == 0) {
- --loopstackptr;
-
- return CONT;
- }
-
- return loopstack[loopstackptr - 1].ipaddr;
- }
-
- /*-
- * MARK count [rand]
- * define the beginning of a loop. (not sure what rand is supposed to do.)
- */
- int
- f_mark(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- default:
- case 2:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- loopstack[loopstackptr].count = intarg(ex, ip);
- loopstack[loopstackptr].ipaddr = ip + 1;
- if (++loopstackptr >= STACKSIZE)
- error("%s: stack overflow\n");
-
- return CONT;
- }
-
- /*-
- * MERGE name
- * add lines to the current program from another
- * (why is this different from CALL?)
- */
- int
- f_merge(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * MODE color
- * change colors in 2 color CGA mode.
- */
- int
- f_mode(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int color;
- int pal = 0;
- int i;
- u_long pmasks;
- u_long pixels[4];
- ImageStruct *im = picreg[0];
-
- switch (nargs) {
- default:
- case 1:
- color = intarg(ex, ip);
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- #if 0
- assert (im);
-
- im->cmaplen = 4;
- if (nargs > 1)
- pal = intarg(ex, ip + 1);
-
- if (!im->cmap) {
- im->cmap = XCreateColormap(dsp, win, vis, AllocNone);
- XAllocColorCells(dsp, im->cmap, True, (unsigned long *) &pmasks, 0,
- (unsigned long *) pixels, im->cmaplen);
- }
- i = 0;
- im->colors[i].pixel = i;
- im->colors[i].red = egapal[color][0];
- im->colors[i].green = egapal[color][1];
- im->colors[i].blue = egapal[color][2];
- im->colors[i].flags = DoRed | DoGreen | DoBlue;
-
- for (i = 1; i < 4; i++) {
- color = cgapal[i - 1][pal];
- im->colors[i].pixel = i;
- im->colors[i].red = egapal[color][0];
- im->colors[i].green = egapal[color][1];
- im->colors[i].blue = egapal[color][2];
- im->colors[i].flags = DoRed | DoGreen | DoBlue;
- }
- XStoreColors(dsp, im->cmap, im->colors, im->cmaplen);
- installcmap(0);
- #endif
-
- return CONT;
- }
-
- /*-
- * MOUSE setting
- * turn mouse on/off
- */
- int
- f_mouse(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * MOVE x1 y1 x2 y2 x3 y3
- * move an area of the screen
- */
- int
- f_move(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int x1;
- int y1;
- int x2;
- int y2;
- int w;
- int h;
- int x3;
- int y3;
-
- switch (nargs) {
- default:
- case 6:
- x1 = intarg(ex, ip);
- y1 = YFLIP(intarg(ex, ip + 1));
- x2 = intarg(ex, ip + 2);
- y2 = YFLIP(intarg(ex, ip + 3));
- w = x2 - x1;
- h = y2 - y1;
- x3 = intarg(ex, ip + 4);
- y3 = YFLIP(intarg(ex, ip + 5)) - h;
- break;
- case 0:
- case 1:
- case 2:
- case 3:
- case 4:
- case 5:
- EXEC_ERROR ();
- break;
- }
-
- // XCopyArea(dsp, win, win, gc, x1, y1, w, h, x3, y3);
-
- return CONT;
- }
-
- /*-
- * NOISE n m time
- * create a sound
- */
- int
- f_noise(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- /* NOP */
- switch (nargs) {
- default:
- case 3:
- break;
- case 0:
- case 1:
- case 2:
- EXEC_ERROR ();
- break;
- }
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * NOTE val tone time [R]
- * play a note
- */
- int
- f_note(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- /* NOP */
- switch (nargs) {
- default:
- case 4:
- case 3:
- break;
- case 0:
- case 1:
- case 2:
- EXEC_ERROR ();
- break;
- }
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * OFFSET x y [R]
- * change the screen coords for some other commands.
- */
- int
- f_offset(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 3:
- case 2:
- yOffset = intarg (ex, ip + 1);
- xOffset = intarg (ex, ip);
- break;
- case 0:
- case 1:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * OPENGL name
- * use files in a library file.
- */
- int
- f_opengl(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * OUT dx al [ah]
- * output a value to an IBM PC hardware I/O port (yeah, right!)
- */
- int
- f_out(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 3:
- case 2:
- break;
- case 0:
- case 1:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * PALETTE buffer
- * set palette colors to match a given picture.
- */
- int
- f_palette(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int cmap;
-
- switch (nargs) {
- default:
- case 1:
- cmap = intarg(ex, ip);
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- installcmap(cmap);
-
- return CONT;
- }
-
- /*-
- * PAN [x1 y1] x2 y2 [R] [speed]
- * pan across large picture in EGA mode.
- */
- int
- f_pan(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 1:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * PFADE fade [buffer] [speed] [delay]
- * display a picture.
- */
- int
- f_pfade(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int fadestyle;
- u_short buf = 0;
- int speed = 0;
- int d = 10;
- ImageStruct *im;
-
- switch (nargs) {
- default:
- case 4:
- d = (int) resolvewild(ex, ip + 3, INTEGER);
- case 3:
- speed = (int) resolvewild(ex, ip + 2, INTEGER);
- case 2:
- buf = (int) resolvewild(ex, ip + 1, INTEGER);
- case 1:
- fadestyle = (int) resolvewild(ex, ip, INTEGER);
- break;
- case 0:
- EXEC_ERROR ();
- }
-
- assert (buf < PICREGSIZE);
- im = picreg[buf];
-
- if (buf == 0) {
- assert (im);
- XSetForeground(dsp, gc, currentcolor);
- XFillRectangle(dsp, im->pix, gc, 0, 0, im->w, im->h);
- }
-
- if (im)
- imagefade(fadestyle, im, 0, 0, speed, 1);
-
- delay(d);
-
- return CONT;
- }
-
- /*-
- * PFREE buffer [buffer] ...
- * unload a picture.
- */
- int
- f_pfree(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- /* NOP */
- switch (nargs) {
- case 0:
- EXEC_ERROR ();
- break;
- default:
- break;
- }
-
- return CONT;
- }
-
- /*-
- * PGETBUF n [x1 y1 x2 y2]
- * copy the screen into a picture buffer, (same as CGETBUF?)
- */
- int
- f_pgetbuf(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 5:
- case 1:
- break;
- case 0:
- case 2:
- case 3:
- case 4:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * PLOAD name [buffer]
- * load a picture.
- */
- int
- f_pload(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- ImageStruct *im;
- u_short regnum;
-
- switch (nargs) {
- default:
- case 2:
- im = imgarg(ex, ip);
- regnum = intarg(ex, ip + 1);
- break;
- case 1:
- im = imgarg(ex, ip);
- regnum = 1;
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- assert (regnum < PICREGSIZE);
- picreg[regnum] = im;
-
- lastRegnum = regnum;
-
- return CONT;
- }
-
- /*-
- * PNEWBUF buffer [x y]
- * create an empty picture buffer. (what is x, y? offset?)
- */
- int
- f_pnewbuf(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 3:
- case 1:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * POINT x y [rx ry]
- * draw a point (what are rx,ry?)
- */
- int
- f_point(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int x;
- int y;
-
- switch (nargs) {
- default:
- case 4:
- case 2:
- x = intarg(ex, ip) + xOffset;
- y = YFLIP(intarg(ex, ip + 1) + yOffset);
- break;
- case 0:
- case 1:
- case 3:
- EXEC_ERROR ();
- break;
- }
-
- XSetForeground(dsp, gc, currentcolor);
- XDrawPoint(dsp, win, gc, x, y);
- XSync(dsp, False);
-
- return CONT;
- }
-
- /*-
- * POKE seg off byte [byte] ...
- * change 8-bit memory given 8088 seg:off address (yeah, right!)
- */
- int
- f_poke(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 2:
- case 1:
- EXEC_ERROR ();
- break;
- default:
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * POKEL seg off byte [byte] ...
- * change 32-bit memory given 8088 seg:off address (yeah, right!)
- */
- int
- f_pokel(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 2:
- case 1:
- EXEC_ERROR ();
- break;
- default:
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * POKEW seg off byte [byte] ...
- * change 16-bit memory given 8088 seg:off address (yeah, right!)
- */
- int
- f_pokew(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 2:
- case 1:
- EXEC_ERROR ();
- break;
- default:
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * POP label
- * leave a subroutine and branch on return.
- */
- int
- f_pop(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 1:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * POSITION buffer x y [R]
- * alter picture placement on the screen.
- */
- int
- f_position(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- u_short buf;
- ImageStruct *pIm;
- int x = intarg(ex, ip + 1);
- int y = intarg(ex, ip + 2);
- int rel = 0;
-
- assert (buf < 128);
-
- switch (nargs) {
- default:
- case 4:
- case 3:
- buf = intarg(ex, ip);
- assert (buf < PICREGSIZE);
- assert (pIm = picreg[buf] /* != (ImageStruct *) NULL */);
- if (nargs == 3)
- {
- pIm->xoff = intarg(ex, ip + 1);
- pIm->yoff = intarg(ex, ip + 2);
- }
- else
- {
- pIm->xoff += intarg(ex, ip + 1);
- pIm->yoff += intarg(ex, ip + 2);
- }
- break;
- case 0:
- case 1:
- case 2:
- EXEC_ERROR ();
- break;
- }
-
- return CONT;
- }
-
- /*-
- * PSAVE name [buffer]
- * save picture buffer to disk.
- */
- int
- f_psave(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 2:
- case 1:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * PSETBUF [buffer]
- * draw to picture buffer instead of screen.
- */
- int
- f_psetbuf(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 1:
- case 0:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * PUTDFF [buffer] [delay] [start] [end] [x y]
- * play a differential animation file.
- */
- int
- f_putdff(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 5:
- case 4:
- case 3:
- case 2:
- case 1:
- case 0:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * PUTUP x y [buffer] [delay]
- * display a clipping
- */
- int
- f_putup(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int x = (int) resolvewild(ex, ip, INTEGER);
- int y = (int) resolvewild(ex, ip + 1, INTEGER);
- u_short clip = (int) resolvewild(ex, ip + 2, INTEGER);
- ImageStruct *im;
- int d = 1;
-
- assert (clip < 128);
- im = clipreg[clip];
- assert (im);
-
- switch (nargs) {
- default:
- case 4:
- d = intarg(ex, ip + 3);
- case 3:
- clip = (int) resolvewild(ex, ip + 2, INTEGER);
- y = (int) resolvewild(ex, ip + 1, INTEGER);
- x = (int) resolvewild(ex, ip, INTEGER);
- break;
- case 0:
- case 1:
- case 2:
- EXEC_ERROR ();
- break;
- }
-
-
- x += im->xoff;
- y += im->yoff;
- XCopyArea(dsp, im->pix, win, gc, 0, 0, im->w, im->h, x, YFLIPIM(y, im));
- XSync(dsp, False);
- delay(d);
- return CONT;
- }
-
- /*-
- * RECT x1 y1 x2 y2
- * draw a filled rectangle;
- */
- int
- f_rect(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int x1;
- int y1;
- int x2;
- int y2;
-
- switch (nargs) {
- default:
- case 4:
- x1 = intarg(ex, ip);
- y1 = intarg(ex, ip + 1);
- x2 = intarg(ex, ip + 2);
- y2 = intarg(ex, ip + 3);
- break;
- case 0:
- case 1:
- case 2:
- case 3:
- EXEC_ERROR ();
- break;
- }
-
- XSetForeground(dsp, gc, currentcolor);
- XFillRectangle(dsp, win, gc, x1, YFLIP(y2), x2 - x1, y2 - y1);
-
- return CONT;
- }
-
- /*-
- * RESETGL
- * close a library
- */
- int
- f_resetgl(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 0:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * RESETSCR
- * reset normal screen size.
- */
- int
- f_resetscr(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 0:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * RETURN [val]
- * return from a subroutine.
- */
- int
- f_return(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- switch (nargs) {
- case 1:
- case 0:
- break;
- #if 0
- default:
- EXEC_ERROR ();
- break;
- #endif
- }
-
- if (--ipstackptr < 0)
- error("%s: ipstack underflow\n");
-
- return ipstack[ipstackptr];
- }
-
- /*-
- * REVPAGE
- * reverse viewing and drawing pages (for double buffering?)
- */
- int
- f_revpage(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 0:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * SEND device string
- * send a character string to a device (yeah, right!)
- */
- int
- f_send(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 2:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * SET function|feature|var value
- * alter system characteristics or alter text features or defines variables...
- */
- int
- f_set(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 2:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * SETCOLOR val0 val1 val2 ... val16
- * define palette in EGA mode
- */
- int
- f_setcolor(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int i;
- u_long pmasks;
- u_long pixels[16];
- ImageStruct *im = picreg[0];
-
-
- if (nargs < 16)
- error("%s: not 16 args to setcolor\n");
-
- assert (im);
-
- im->cmaplen = nargs;
-
- if (!im->cmap) {
- im->cmap = XCreateColormap(dsp, win, vis, AllocNone);
- XAllocColorCells(dsp, im->cmap, True, (unsigned long *) &pmasks,
- 0, (unsigned long *) pixels, im->cmaplen);
- }
-
- for (i = 0; i < im->cmaplen; i++)
- {
- int pal = intarg(ex, ip + i);
- im->colors[i].pixel = i;
- im->colors[i].red = decodepal(pal, 0x20, 0x04) << 8;
- im->colors[i].green = decodepal(pal, 0x10, 0x02) << 8;
- im->colors[i].blue = decodepal(pal, 0x08, 0x01) << 8;
- im->colors[i].flags = DoRed | DoGreen | DoBlue;
- }
-
- XStoreColors(dsp, im->cmap, im->colors, im->cmaplen);
- installcmap(0);
-
- return CONT;
- }
-
- /*-
- * SETPAGE view draw
- * define viewing and drawing pages for double buffering.
- */
- int
- f_setpage(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 2:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * SETRGB start r g b [R] rand
- * change color in VGA mode (not sure what R or rand do...)
- */
- int
- f_setrgb(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int start;
- int r;
- int g;
- int b;
- XColor c;
- ImageStruct *pIm;
- XColor *pColors;
-
- switch (nargs) {
- default:
- case 6:
- case 5:
- case 4:
- start = intarg(ex, ip);
- r = intarg(ex, ip + 1);
- g = intarg(ex, ip + 2);
- b = intarg(ex, ip + 3);
- break;
- case 0:
- case 1:
- case 2:
- case 3:
- EXEC_ERROR ();
- break;
- }
-
- assert (pIm = picreg[palettenum] /* != (ImageStruct *) NULL */);
- assert (pColors = pIm->colors /* != (XColor *) NULL */);
-
- c.pixel = pColors[start].pixel;
- c.red = r << 8;
- c.green = g << 8;
- c.blue = b << 8;
- c.flags = DoRed | DoGreen | DoBlue;
-
- if (installedcmap == (Colormap) NULL)
- {
- if (lastRegnum == -1)
- return CONT;
- else
- installcmap (lastRegnum);
- }
-
- if (installedcmap /* != (Colormap) NULL */)
- XStoreColors (dsp, installedcmap, &c, 1);
-
- return CONT;
- }
-
- /*-
- * SETUPSCR buffer
- * create a virtual screen for panning.
- */
- int
- f_setupscr(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * SPLIT line [R]
- * divide an EGA screen into two independant areas.
- */
- int
- f_split(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- default:
- case 2:
- case 1:
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
-
- #define lerp(a,b,step,nsteps) \
- ((a)<(b) \
- ? (a) + ((b) - (a)) * (step) / (nsteps) \
- : (b) + ((a) - (b)) * (step) / (nsteps))
-
-
- /*-
- * SPREAD [pal1] pal2 [steps]
- * cross-fade between two VGA palettes.
- */
- int
- f_spread(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- u_short r1;
- u_short r2;
- ImageStruct *p1;
- ImageStruct *p2;
- int n = 1;
- XColor colors[256];
- int i;
- int j;
- Colormap cmap;
- unsigned long pmasks;
- unsigned long pixels[256];
- int len;
-
- switch (nargs) {
- default:
- case 3:
- n = intarg(ex, ip + 2);
- case 2:
- r2 = intarg(ex, ip + 1);
- r1 = intarg(ex, ip);
- assert (r1 < PICREGSIZE);
- assert (r2 < PICREGSIZE);
- p2 = picreg[r2];
- p1 = picreg[r1];
- assert (p1);
- assert (p2);
- break;
- case 0:
- case 1:
- EXEC_ERROR ();
- break;
- }
-
- n = (n < 0) ? -n : n;
-
- len = p1->cmaplen;
-
- if (len != p2->cmaplen)
- error("%s: %d,%d spread length mismatch\n", len, p2->cmaplen);
-
- cmap = XCreateColormap(dsp, win, vis, AllocNone);
- XAllocColorCells(dsp, cmap, True, &pmasks, 0, pixels, len);
- for (i = 0; i < len; i++) {
- colors[i].pixel = pixels[i];
- colors[i].red = p1->colors[i].red;
- colors[i].green = p1->colors[i].green;
- colors[i].blue = p1->colors[i].blue;
- colors[i].flags = DoRed | DoGreen | DoBlue;
- }
- XStoreColors(dsp, cmap, p1->colors, p1->cmaplen);
- XSetWindowColormap(dsp, win, cmap);
-
- for (j = 1; j <= n; j++) {
- for (i = 0; i < len; i++) {
- XColor *c1 = &(p1->colors[i]);
- XColor *c2 = &(p2->colors[i]);
- colors[i].red = lerp(c1->red, c2->red, j, n);
- colors[i].green = lerp(c1->green, c2->green, j, n);
- colors[i].red = lerp(c1->red, c2->red, j, n);
- }
- XStoreColors(dsp, cmap, colors, p1->cmaplen);
- XSync(dsp, False);
- }
- installcmap(r2);
- XFreeColormap(dsp, cmap);
- XSync(dsp, False);
-
- return -1;
- }
-
- void
- displaystring(s, x, y)
- char *s;
- int x, y;
- {
- int i;
-
-
- if (verbose)
- fprintf (stderr, "Text: \"%s\"\n", s);
-
- {
- GrafPtr oldPort;
- Rect aRect;
- FontInfo fInfo;
-
-
- GetPort (&oldPort);
- SetPort ((WindowPtr) dsp);
- TextSize (currentfont->height);
-
- MoveTo (x, y);
- TextMode (srcOr);
- DrawText (s, 0, strlen (s));
- SetPort (oldPort);
- }
-
- #if 0
- for (i = 0; i < strlen(s); i++)
- {
- GlyphStruct *g = ¤tfont->glyphs[s[i]];
-
- if (g->pix)
- {
- XSetStipple(dsp, gc, g->pix);
- XSetTSOrigin(dsp, gc, x - g->lbearing, y);
- /*****
- XFillRectangle(dsp, win, gc, x, y, g->width, currentfont->height);
- ******/
- x += g->width + chargap;
- }
- }
- #endif
- }
-
- /*-
- * TEXT [x y] string [delay]
- * print characters on the screen.
- */
- int
- f_text(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int x;
- int y;
- char *s;
- int d = 1;
- int i;
-
-
- switch (nargs) {
- default:
- case 4:
- d = intarg(ex, ip + 3);
- case 3:
- s = strarg(ex, ip + 2);
- y = intarg(ex, ip + 1);
- x = intarg(ex, ip);
- break;
- case 0:
- case 1:
- case 2:
- EXEC_ERROR ();
- break;
- }
-
- if (!currentfont) {
- /* hack there should be a default font. */
- XSetForeground(dsp, gc, currentcolor);
- XSetBackground(dsp, gc, currentbgcolor);
- XDrawString(dsp, win, gc, x, YFLIP(y), s, strlen(s));
- goto text_exit;
- }
- currentfont->glyphs[' '].width = spacegap;
- y = YFLIP(y) - currentfont->height - 2;
- XSetFillStyle(dsp, gc, FillStippled);
- XSetForeground(dsp, gc, (fstyle > 2) ? currentbgcolor : currentcolor);
- switch (fstyle) {
- case 0:
- break;
- case 1:
- displaystring(s, x, y - 1); /* bold up */
- break;
- case 2:
- displaystring(s, x + 1, y); /* bold right */
- break;
- case 3:
- displaystring(s, x + 1, y - 1); /* shadow up right */
- break;
- case 4:
- displaystring(s, x - 1, y - 1); /* shadow up left */
- break;
- case 5:
- displaystring(s, x + 2, y - 2); /* shadow up right 2 pixels */
- break;
- case 6:
- displaystring(s, x - 2, y - 2); /* shadow up left 2 pixels */
- break;
- default:
- break;
- }
- XSetForeground(dsp, gc, currentcolor);
- displaystring(s, x, y);
- XSetFillStyle(dsp, gc, FillSolid);
-
- text_exit:
- XSync(dsp, False);
- delay(d);
-
- return CONT;
- }
-
- /*-
- * TILE buffer [bleed]
- * fill screen with copies of the clipping.
- */
- int
- f_tile(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- ImageStruct *im;
- int x;
- int y;
-
- switch (nargs) {
- default:
- case 2:
- case 1:
- {
- u_short ithImage = intarg(ex, ip);
-
-
- assert (ithImage < 128);
- im = clipreg[ithImage];
- assert (im);
- break;
- }
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- assert (picreg[0]);
-
- for (y = 0; y <= picreg[0]->h - im->h; y += im->h)
- for (x = 0; x <= picreg[0]->w - im->w; x += im->w)
- XCopyArea(dsp, im->pix, win, gc, 0, 0, im->w, im->h, x, y);
- delay(10);
-
- return CONT;
- }
-
- /*-
- * TIMER
- * set the system clock for execution timing (huh?)
- */
- int
- f_timer(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 0:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * TRAN set [color ...]
- * set = "on"|"off", make color be transparent in clippings.
- */
- int
- f_tran(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int tranval;
-
- switch (nargs) {
- default:
- case 1:
- tranval = intarg(ex, ip);
- break;
- case 0:
- EXEC_ERROR ();
- break;
- }
-
- return -1;
- }
-
- /*-
- * VIDEO mode [x y] [init]
- * set the display mode (not sure what x and y and init are for)
- */
- int
- f_video(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- char *s;
- char c;
-
- switch (nargs) {
- default:
- case 4:
- case 3:
- case 1:
- s = strarg(ex, ip);
- c = s[0];
- break;
- case 0:
- case 2:
- EXEC_ERROR ();
- break;
- }
-
- setvideomode(c);
-
- return CONT;
- }
-
-
- /*-
- * WAITKEY [time] [label]
- * wait for a keystroke or a given time, and jump to label on timeout.
- */
- int
- f_waitkey(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- long endtime = 0;
- int retaddr = CONT;
- char fHaveTime;
-
- switch (nargs) {
- default:
- case 2:
- retaddr = intarg(ex, ip + 1);
- case 1:
- endtime = hundredthsofseconds() + intarg(ex, ip);
- fHaveTime = 1;
- break;
- case 0:
- fHaveTime = 0;
- break;
- #if 0
- default:
- EXEC_ERROR ();
- break;
- #endif
- }
-
- while (1)
- {
- exitcheck();
- usleep(10000); /* sleep for 1/100th of a second */
- if (MouseButton() || Keypress(&keypressed))
- return retaddr;
- if (fHaveTime && (hundredthsofseconds() > endtime))
- return retaddr;
- }
- }
-
-
- /*-
- * WHEN key [command]
- * set up an automatic response for given keystroke.
- */
- int
- f_when(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- #ifdef UNIMPLEMENTED
- switch (nargs) {
- case 2:
- case 1:
- break;
- default:
- EXEC_ERROR ();
- break;
- }
- #endif
-
- return unimplemented(ex, ip);
- }
-
- /*-
- * WINDOW x1 y1 x2 y2 [R]
- * limit screen changes to given area.
- */
- int
- f_window(ex, ip, nargs)
- ExecStruct *ex;
- int ip;
- int nargs;
- {
- int offset_x;
- int offset_y;
-
- switch (nargs) {
- default:
- case 5: // relative
- {
- offset_x = window.x;
- offset_y = YFLIP(window.y) - window.height;
- window.x = intarg(ex, ip);
- window.y = intarg(ex, ip + 1);
- window.width = intarg(ex, ip + 2) - window.x + 1;
- window.height = intarg(ex, ip + 3) - window.y + 1;
- window.x = window.x + offset_x;
- window.y = YFLIP(intarg(ex, ip + 3) + offset_y);
- break;
- }
- case 4: // absolute
- window.x = intarg(ex, ip);
- window.y = intarg(ex, ip + 1);
- window.width = intarg(ex, ip + 2) - window.x + 1;
- window.height = intarg(ex, ip + 3) - window.y + 1;
- window.y = YFLIP(intarg(ex, ip + 3));
- break;
- case 0: // restore default
- window.x = 0;
- window.y = 0;
- assert (picreg[0]);
- window.width = picreg[0]->w;
- window.height = picreg[0]->h;
- break;
- case 1:
- case 2:
- case 3:
- EXEC_ERROR ();
- }
-
- if (videomode == 'c')
- {
- window.height <<= 1;
- window.y <<= 1;
- }
-
- return CONT;
- }
-
- int (*funcs[]) () = {
- 0,
- f_box,
- f_break,
- f_call,
- f_cfade,
- f_cfree,
- f_cgetbuf,
- f_chgcolor,
- f_circle,
- f_clearscr,
- f_cload,
- f_closegl,
- f_color,
- f_cycle,
- f_data,
- f_databegin,
- f_dataend,
- f_dataskip,
- f_dfree,
- f_dload,
- f_edge,
- f_else,
- f_endlfloat,
- f_endif,
- f_exec,
- f_exit,
- f_ffree,
- f_fgaps,
- f_fload,
- f_float,
- f_fly,
- f_font,
- f_fstyle,
- f_getcolor,
- f_getkey,
- f_gosub,
- f_goto,
- f_if,
- f_ifkey,
- f_ifmem,
- f_ifmouse,
- f_ifvideo,
- f_int,
- f_line,
- f_link,
- f_local,
- f_loop,
- f_mark,
- f_merge,
- f_mode,
- f_mouse,
- f_move,
- f_noise,
- f_note,
- f_offset,
- f_opengl,
- f_out,
- f_palette,
- f_pan,
- f_pfade,
- f_pfree,
- f_pgetbuf,
- f_pload,
- f_pnewbuf,
- f_point,
- f_poke,
- f_pokel,
- f_pokew,
- f_pop,
- f_position,
- f_psave,
- f_psetbuf,
- f_putdff,
- f_putup,
- f_rect,
- f_resetgl,
- f_resetscr,
- f_return,
- f_revpage,
- f_send,
- f_set,
- f_setcolor,
- f_setpage,
- f_setrgb,
- f_setupscr,
- f_split,
- f_spread,
- f_text,
- f_tile,
- f_timer,
- f_tran,
- f_video,
- f_waitkey,
- f_when,
- f_window,
- f_pfade,
- f_waitkey
- };
-
-
- void
- printexec(ex, nargs)
- ExecStruct *ex;
- int nargs;
- {
- int i;
-
- fprintf(stderr,"executing: %s", tokens[ex->Code[ex->ip].token]);
- for (i = 1; i <= nargs; i++)
- switch (ex->Code[ex->ip + i].token) {
- case STRING:
- fprintf(stderr," %s", ex->Code[ex->ip + i].val.s);
- break;
- case INTEGER:
- fprintf(stderr," %d", ex->Code[ex->ip + i].val.i);
- break;
- case IMAGE:
- fprintf(stderr," %s", ex->Code[ex->ip + i].val.image->name);
- break;
- case FONTTYPE:
- if (ex->Code[ex->ip + i].val.font)
- fprintf(stderr," %s", ex->Code[ex->ip + i].val.font->name);
- else
- fprintf(stderr," (nil)");
- break;
- case EXECTYPE:
- fprintf(stderr," %s", ex->Code[ex->ip + i].val.exec->name);
- break;
- case WILDTYPE:
- fprintf(stderr," @");
- break;
- default:
- error("%s: bogus token type.\n");
- }
- fprintf(stderr,"\n");
- }
-
-
- void
- execfile(ex, ip)
- ExecStruct *ex;
- int ip;
- {
- ex->ip = ip;
- ex->currentdataptr = -1;
- ex->currentdataend = -1;
-
- while (1)
- {
- int nargs = ex->Code[ex->ip].val.i;
- int i = ex->Code[ex->ip].token;
- int retval;
-
- if (i > NTOKENS) {
- fprintf(stderr,"skipping bogus token %s\n", ex->Code[ex->ip].val.s);
- ex->ip++;
- continue;
- }
-
- if (verbose)
- printexec(ex, nargs);
-
- switch (retval = funcs[i] (ex, ex->ip + 1, nargs)) {
- case DONE:
- return;
- case ESCAPE:
- exit(0);
- case CONT:
- if ((ex->ip += (nargs + 1)) >= ex->numcodes)
- return;
- break;
- default:
- ex->ip = retval;
- }
- exitcheck();
- }
- }
-